home *** CD-ROM | disk | FTP | other *** search
/ START Magazine / START VOL 3 NO 5.st / GENINPUT.ARC / LISTING2.LST < prev    next >
Encoding:
File List  |  1988-09-20  |  38.3 KB  |  1,292 lines
  1. ' =============================================================================
  2. '     LISTING 2           GENERALIZED INPUT ROUTINES
  3. '                              BY MICHAEL HEPNER
  4. '                       COPYRIGHT 1988 ANTIC PUBLISHING
  5. ' =============================================================================
  6. '
  7. Fullw 1
  8. Titlew 1," Generalized Input Routines "
  9. Cls
  10. '
  11. ' -----------------------------------------------------------------------------
  12. '       CHECK SCREEN RESOLUTION:  Must run in MEDIUM or HIGH resolution.
  13. ' -----------------------------------------------------------------------------
  14. Rez%=Xbios(4)
  15. If Rez%=0 Then
  16.   Alert 3," Please switch to | | MEDIUM RESOLUTION ",1," OK ",B
  17.   Quit
  18. Endif
  19. '
  20. ' -----------------------------------------------------------------------------
  21. '     INITIALIZE: Dimension Arrays and call the Generalized Init. Routines
  22. ' -----------------------------------------------------------------------------
  23. Max_recs%=90
  24. Dim Friend$(90),Street$(90),City$(90),State$(90),Zip$(90),Phone$(90)
  25. '
  26. Gosub Menu_setup
  27. Gosub Fld_dimen
  28. '
  29. ' -----------------------------------------------------------------------------
  30. '                      SHOW LIST OF OPTIONS AVAILABLE:
  31. '              When selected option is done, show the list again.
  32. ' -----------------------------------------------------------------------------
  33. Do
  34.   Gosub Show_main_option_list
  35. Loop
  36. '
  37. ' ----------------------------  END OF MAIN PROGRAM  --------------------------
  38. '
  39. '
  40. ' =============================================================================
  41. ' SHOW_MAIN_OPTION_LIST:  This procedure shows how to initialize the DATA
  42. '        values and call the Generalized Option List Procedure.
  43. ' -----------------------------------------------------------------------------
  44. Procedure Show_main_option_list
  45.   Titlew 1," Generalized Input Routines "
  46.   '
  47.   Restore Main_list_menu_data                   ! Build the customized
  48.   Gosub Build_menu_bar                          ! drop down menus.
  49.   '
  50.   Repeat
  51.     Restore Main_option_list_data               ! Build the customized
  52.     Gosub Show_option_list                      ! option list.
  53.     '
  54.     Gosub Check_which_option                    ! Wait for MOUSE or Func-key.
  55.   Until Function%>0
  56.   '
  57.   On Function% Gosub Option1,Option2,Option3
  58. Return
  59. '
  60. '
  61. ' =============================================================================
  62. ' ==========              OPTION 1  -  CREATE NEW RECORDS            ==========
  63. ' =============================================================================
  64. Procedure Option1
  65.   Titlew 1," Create New Records "
  66.   Cls
  67.   '
  68.   Restore Opt1_menu_data                        ! Different
  69.   Gosub Build_menu_bar                          ! drop down menus.
  70.   '
  71.   Restore Opt1_fld_data                         ! Set up the
  72.   Gosub Fld_setup                               ! data entry screen.
  73.   '
  74.   Opt_done%=0
  75.   While Opt_done%=0 And Num_recs%<Max_recs%
  76.     Gosub Create_rec
  77.   Wend
  78.   '
  79.   If Num_recs%>=Max_recs% Then
  80.     Alert 3," Maximum Number | of records has | been reached. ",1," OK ",B
  81.   Endif
  82. Return
  83. '
  84. ' =============================================================================
  85. ' CREATE_REC:  Initialize all fields to spaces.  Call REC_INPUT to do the work.
  86. ' -----------------------------------------------------------------------------
  87. Procedure Create_rec
  88.   Inc Num_recs%
  89.   Rec_num%=Num_recs%
  90.   '
  91.   For I%=1 To Num_flds%
  92.     Fld_val$(I%)=Space$(Fld_leng%(I%))
  93.   Next I%
  94.   '
  95.   Gosub Rec_input
  96.   '
  97.   If Rec_done%=99 Then
  98.     Dec Num_recs%
  99.   Endif
  100. Return
  101. '
  102. ' =============================================================================
  103. ' REC_INPUT:  This procedure processes the data entry screen.
  104. ' -----------------------------------------------------------------------------
  105. Procedure Rec_input
  106.   Redraw%=1
  107.   '
  108.   Rec_done%=0
  109.   '
  110.   Repeat
  111.     If Redraw%=1 Then                           ! First time or after desk
  112.       Gosub Show_headings                       ! accessory, display screen.
  113.     Endif
  114.     '
  115.     Gosub Ask_for_field                         ! Input the field.
  116.     Fld_num%=Nxt_fld%                           ! Next field selected.
  117.     '
  118.     If Rec_done%=1 Then
  119.       Xsub%=1
  120.       For Fld_num%=1 To Num_flds%
  121.         Gosub Validate_field
  122.         Exit If Rec_done%=0
  123.       Next Fld_num%
  124.     Endif
  125.   Until Rec_done%>0                             ! Loop thru all fields.
  126.   '
  127.   If Rec_done%=1 Then
  128.     Friend$(Rec_num%)=Fld_val$(1)
  129.     Street$(Rec_num%)=Fld_val$(2)
  130.     City$(Rec_num%)=Fld_val$(3)
  131.     State$(Rec_num%)=Fld_val$(4)
  132.     Zip$(Rec_num%)=Fld_val$(5)
  133.     Phone$(Rec_num%)=Fld_val$(6)
  134.   Endif
  135. Return
  136. '
  137. ' =============================================================================
  138. '                          SUBROUTINES FOR FIELD EDITS
  139. ' =============================================================================
  140. Procedure Ask_for_field
  141.   Temp$=Fld_val$(Fld_num%)
  142.   Gosub Check_field_input
  143.   Fld_val$(Fld_num%)=Temp$
  144.   '
  145.   Gosub Clear_box
  146.   '
  147.   If Fld_done%=1 Then
  148.     Gosub Validate_field
  149.   Endif
  150. Return
  151. '
  152. '
  153. ' =============================================================================
  154. ' VALIDATE_FIELD:  For those fields that need edits, call the edit procedure.
  155. ' -----------------------------------------------------------------------------
  156. Procedure Validate_field
  157.   On Fld_num% Gosub Edit_name,Edit_street,No_edit,No_edit,No_edit,Edit_phone
  158. Return
  159. '
  160. ' =============================================================================
  161. Procedure Edit_name
  162.   If Fld_val$(1)=Space$(Fld_leng%(1)) Then
  163.     Print At(24,19);"Friend's name may not be blank."
  164.     Fld_done%=0
  165.     Nxt_fld%=Fld_num%
  166.     Rec_done%=0
  167.   Endif
  168. Return
  169. '
  170. ' =============================================================================
  171. Procedure Edit_street
  172.   If Fld_val$(2)=Space$(Fld_leng%(2)) Then
  173.     Print At(23,19);"Friend's street may not be blank."
  174.     Fld_done%=0
  175.     Nxt_fld%=Fld_num%
  176.     Rec_done%=0
  177.   Endif
  178. Return
  179. '
  180. ' =============================================================================
  181. Procedure Edit_phone
  182.   If Fld_val$(6)=Space$(Fld_leng%(6)) Then
  183.     Print At(24,19);"Friend's phone may not be blank."
  184.     Fld_done%=0
  185.     Nxt_fld%=Fld_num%
  186.     Rec_done%=0
  187.   Endif
  188. Return
  189. '
  190. ' =============================================================================
  191. Procedure No_edit
  192. Return
  193. '
  194. '
  195. ' =============================================================================
  196. ' ==========         OPTION 2  -  LIST/EDIT/DELETE RECORDS           ==========
  197. ' =============================================================================
  198. Procedure Option2
  199.   Titlew 1," List/Edit/Delete Records "
  200.   Cls
  201.   '
  202.   Restore Opt2_menu_data                        ! Different
  203.   Gosub Build_menu_bar                          ! drop down menus.
  204.   '
  205.   Restore Opt1_fld_data                         ! Uses the same
  206.   Gosub Fld_setup                               ! field definitions.
  207.   '
  208.   Opt_done%=0
  209.   Repeat
  210.     Gosub List_records
  211.   Until Opt_done%>0
  212. Return
  213. '
  214. ' =============================================================================
  215. ' LIST_RECORDS:  Build headers for the list screen.
  216. ' -----------------------------------------------------------------------------
  217. Procedure List_records
  218.   Cls
  219.   Print At(25,2);Num_recs%;" record(s) have been entered."
  220.   '
  221.   If Num_recs%>0 Then
  222.     Print At(6,4);"#   ";Fld_heading$(1)
  223.     Print At(6,5);"--  ";String$(Fld_leng%(1),"-")
  224.     X%=Fld_leng%(1)+12
  225.     Print At(X%,4);Fld_heading$(2)
  226.     Print At(X%,5);String$(Fld_leng%(2),"-")
  227.     X%=X%+2+Fld_leng%(2)
  228.     Print At(X%,4);Fld_heading$(6)
  229.     Print At(X%,5);String$(Fld_leng%(6),"-")
  230.     '
  231.     Show_prev%=0
  232.     Gosub List_15_recs
  233.     Gosub Highlight
  234.   Endif
  235.   '
  236.   Rec_done%=0
  237.   Repeat
  238.     Gosub Check_which_record
  239.   Until Rec_done%>0 Or Redraw%=1
  240. Return
  241. '
  242. '
  243. ' =============================================================================
  244. ' LIST_15_RECS:  List 15 records to the screen.
  245. ' -----------------------------------------------------------------------------
  246. Procedure List_15_recs
  247.   Deffill 0,1
  248.   Pbox 24,39*Rez%,614,176*Rez%
  249.   '
  250.   Show_limit%=Min(15,Num_recs%-Show_prev%)
  251.   '
  252.   For I%=1 To Show_limit%
  253.     S%=Show_prev%+I%
  254.     Print At(6,5+I%);S%;"."
  255.     Print At(10,5+I%);Friend$(S%);"  ";Street$(S%);"  ";Phone$(S%)
  256.   Next I%
  257.   '
  258.   Show_num%=1
  259.   '
  260.   If (Show_prev%+Show_limit%)<Num_recs% Then
  261.     Deftext 3,0,0,Txt_size%
  262.     Text 96,172*Rez%,"More"
  263.     Deftext 1,0,0,Txt_size%
  264.     Color 2
  265.     Defline 1,1,0,0
  266.     Box 64,164*Rez%,160,174*Rez%
  267.   Endif
  268.   '
  269.   If Show_prev%>0 Then
  270.     Deftext 3,0,0,Txt_size%
  271.     Text 480,172*Rez%,"Start over"
  272.     Deftext 1,0,0,Txt_size%
  273.     Color 2
  274.     Defline 1,1,0,0
  275.     Box 464,164*Rez%,576,174*Rez%
  276.   Endif
  277. Return
  278. '
  279. '
  280. ' =============================================================================
  281. ' HIGHLIGHT:  Show one record in inverse video.
  282. ' -----------------------------------------------------------------------------
  283. Procedure Highlight
  284.   Graphmode 3
  285.   Deffill 1,1
  286.   Yline%=(39+8*Show_num%)*Rez%
  287.   Pbox 34,Yline%+2*Rez%,603,Yline%-7*Rez%
  288.   Graphmode 1
  289. Return
  290. '
  291. '
  292. ' ==============================================================================
  293. ' EDIT_RECORD:  Edit an existing record.  Call REC_INPUT to do the work.
  294. ' -----------------------------------------------------------------------------
  295. Procedure Edit_record
  296.   If Num_recs%>0 Then
  297.     Rec_num%=Show_num%+Show_prev%
  298.     Fld_val$(1)=Friend$(Rec_num%)
  299.     Fld_val$(2)=Street$(Rec_num%)
  300.     Fld_val$(3)=City$(Rec_num%)
  301.     Fld_val$(4)=State$(Rec_num%)
  302.     Fld_val$(5)=Zip$(Rec_num%)
  303.     Fld_val$(6)=Phone$(Rec_num%)
  304.     Gosub Rec_input
  305.   Endif
  306. Return
  307. '
  308. '
  309. ' =============================================================================
  310. ' DELETE_RECORD:  Remove the record from the table.
  311. ' -----------------------------------------------------------------------------
  312. Procedure Delete_record
  313.   If Num_recs%>0 Then
  314.     Rec_num%=Show_num%+Show_prev%
  315.     Alert 2,"Delete the|highlighted|record",1," yes | no ",B
  316.     If B=1 Then
  317.       Gosub Shift_records_down
  318.     Endif
  319.   Endif
  320. Return
  321. '
  322. '
  323. ' =============================================================================
  324. ' SHIFT_RECORDS_DOWN:  To replace the deleted record.
  325. ' -----------------------------------------------------------------------------
  326. Procedure Shift_records_down
  327.   If Rec_num%<Num_recs% Then
  328.     For I%=Rec_num% To Num_recs%-1
  329.       Friend$(I%)=Friend$(I%+1)
  330.       Street$(I%)=Street$(I%+1)
  331.       City$(I%)=City$(I%+1)
  332.       State$(I%)=State$(I%+1)
  333.       Zip$(I%)=Zip$(I%+1)
  334.       Phone$(I%)=Phone$(I%+1)
  335.     Next I%
  336.   Endif
  337.   Dec Num_recs%
  338.   Rec_done%=1
  339. Return
  340. '
  341. '
  342. ' =============================================================================
  343. ' ==========                   OPTION 3  -  EXIT                     ==========
  344. ' =============================================================================
  345. Procedure Option3
  346.   Alert 2,"    Do you really    | |    want to QUIT?    ",1,"YES|NO ",B
  347.   If B=1 Then
  348.     @Restorepal
  349.     Edit
  350.   Endif
  351. Return
  352. '
  353. '
  354. ' =============================================================================
  355. '                   ROUTINES TO LOAD AND SAVE THE DATA FILES
  356. ' =============================================================================
  357. Procedure Load_file
  358.   Print At(6,2);"LOAD FILE"
  359.   Fileselect "\*.FIL","",Lfile$
  360.   If Len(Lfile$)>0 Then
  361.     Open "R",#1,Lfile$,99
  362.     Field #1,25 As Rec_name$,25 As Rec_street$,20 As Rec_city$,12 As Rec_state$,5 As Rec_zip$,12 As Rec_phone$
  363.     For I%=1 To Max_recs%
  364.       Get #1,I%
  365.       Friend$(I%)=Rec_name$
  366.       Street$(I%)=Rec_street$
  367.       City$(I%)=Rec_city$
  368.       State$(I%)=Rec_state$
  369.       Zip$(I%)=Rec_zip$
  370.       Phone$(I%)=Rec_phone$
  371.       Num_recs%=I%
  372.       Exit If Eof(#1)
  373.     Next I%
  374.     Close #1
  375.   Endif
  376.   Print At(6,2);"         "
  377. Return
  378. '
  379. ' =============================================================================
  380. Procedure Save_file
  381.   If Num_recs%>0 Then
  382.     Print At(6,2);"SAVE FILE"
  383.     Fileselect "\*.FIL","",Sfile$
  384.     If Len(Sfile$)>0 Then
  385.       If Exist(Sfile$)=-1 Then
  386.         Kill Sfile$
  387.       Endif
  388.       Open "R",#1,Sfile$,99
  389.       Field #1,25 As Rec_name$,25 As Rec_street$,20 As Rec_city$,12 As Rec_state$,5 As Rec_zip$,12 As Rec_phone$
  390.       For I%=1 To Num_recs%
  391.         Lset Rec_name$=Friend$(I%)
  392.         Lset Rec_street$=Street$(I%)
  393.         Lset Rec_city$=City$(I%)
  394.         Lset Rec_state$=State$(I%)
  395.         Lset Rec_zip$=Zip$(I%)
  396.         Lset Rec_phone$=Phone$(I%)
  397.         Put #1,I%
  398.       Next I%
  399.       Close #1
  400.     Endif
  401.     Print At(6,2);"         "
  402.   Endif
  403. Return
  404. '
  405. '
  406. ' =============================================================================
  407. '               GENERALIZED INPUT ROUTINES TO PROCESS THE MENU BAR
  408. ' =============================================================================
  409. '
  410. ' -----------------------------------------------------------------------------
  411. ' MENU_SETUP:  Dimension the Menu Bar Array, initialize variables,
  412. '              and set the screen colors and text size.
  413. ' -----------------------------------------------------------------------------
  414. Procedure Menu_setup
  415.   Max_menu%=150
  416.   Dim Menu_bar$(Max_menu%)
  417.   Dim Spalette%(16,3)
  418.   '
  419.   @Save_pal
  420.   Insert_mode%=0
  421.   First_redraw%=0
  422.   Redraw%=0
  423.   '
  424.   If Rez%=1 Then
  425.     Setcolor 0,7,7,7
  426.     Setcolor 1,7,0,0
  427.     Setcolor 2,0,0,4
  428.     Setcolor 3,0,0,0
  429.     Txt_size%=6
  430.   Else
  431.     Setcolor 0,7,7,7
  432.     Setcolor 1,0,0,0
  433.     Txt_size%=13
  434.   Endif
  435. Return
  436. '
  437. '
  438. ' ==============================================================================
  439. ' BUILD_MENU_BAR:  Builds the drop down menus and activates them.
  440. ' -----------------------------------------------------------------------------
  441. Procedure Build_menu_bar
  442.   For I%=0 To Max_menu%
  443.     Read Menu_bar$(I%)
  444.     Exit If Menu_bar$(I%)="***"
  445.   Next I%
  446.   '
  447.   Menu_bar$(I%)=""
  448.   Menu Menu_bar$()
  449.   On Menu  Gosub Menu_handler
  450.   On Menu Message Gosub Menu_message
  451. Return
  452. '
  453. ' -----------------------------------------------------------------------------
  454. ' DATA for MENU BAR:  First line is needed to activate the desk accessories.
  455. '        On other lines, the first value will appear on the menu bar and the
  456. '        following values will appear on the drop down menu.
  457. ' -----------------------------------------------------------------------------
  458. Main_list_menu_data:
  459. Data DESK, About Gen. Input ,------------------,1,2,3,4,5,6,""
  460. Data QUIT, End Program,""
  461. Data FILE, Load File, Save File,""
  462. Data ***
  463. '
  464. Opt1_menu_data:
  465. Data DESK, About Gen. Input ,------------------,1,2,3,4,5,6,""
  466. Data QUIT, End Program,""
  467. Data DONE, Return to Menu,""
  468. Data CANCEL, Start New Record, Return to Menu,""
  469. Data ***
  470. '
  471. Opt2_menu_data:
  472. Data DESK, About Gen. Input ,------------------,1,2,3,4,5,6,""
  473. Data QUIT, End Program,""
  474. Data DONE, Return to Menu,""
  475. Data UPDATE, Edit Record, Delete Record,""
  476. Data ***
  477. '
  478. '
  479. ' =============================================================================
  480. ' MENU_HANDLER:  Determines which drop down menu option was selected.
  481. ' -----------------------------------------------------------------------------
  482. Procedure Menu_handler
  483.   Menu Off
  484.   Menu_option$=Menu_bar$(Menu(0))
  485.   '
  486.   If Menu_option$=" Start New Record" Then
  487.     Fld_done%=99
  488.     Rec_done%=99
  489.   Endif
  490.   '
  491.   If Menu_option$=" Return to Menu" Then
  492.     Fld_done%=99
  493.     Rec_done%=99
  494.     Opt_done%=99
  495.   Endif
  496.   '
  497.   If Menu_option$=" Load File" Then
  498.     Gosub Load_file
  499.   Endif
  500.   '
  501.   If Menu_option$=" Save File" Then
  502.     Gosub Save_file
  503.   Endif
  504.   '
  505.   If Menu_option$=" Edit Record" Then
  506.     M0%=Menu(0)
  507.     Menu M0%,2
  508.     Menu M0%+1,2
  509.     Gosub Edit_record
  510.     Menu M0%,3
  511.     Menu M0%+1,3
  512.   Endif
  513.   '
  514.   If Menu_option$=" Delete Record" Then
  515.     Gosub Delete_record
  516.   Endif
  517.   '
  518.   If Menu_option$=" End Program" Then
  519.     Gosub Option3
  520.   Endif
  521.   '
  522.   If Menu_option$=" About Gen. Input " Then
  523.     A1$="Generalized Input Routines|"
  524.     A2$="   Sample -- Listing 2|"
  525.     A3$="    by Michael Hepner|"
  526.     A4$=" "+Chr$(189)+" 1988 Antic Publishing"
  527.     Alert 1,A1$+A2$+A3$+A4$,1,"OK",A
  528.   Endif
  529. Return
  530. '
  531. '
  532. ' =============================================================================
  533. ' MENU_MESSAGE:  Determine if the screen needs to be redrawn.
  534. '        (Ignore first call which comes at the start of the program.)
  535. ' -----------------------------------------------------------------------------
  536. Procedure Menu_message
  537.   If Menu(1)=20 Then
  538.     If First_redraw%=0 Then
  539.       First_redraw%=1
  540.     Else
  541.       Redraw%=1
  542.     Endif
  543.     '
  544.     If Rez%=1 Then
  545.       Setcolor 0,7,7,7
  546.       Setcolor 1,7,0,0
  547.       Setcolor 2,0,0,4
  548.       Setcolor 3,0,0,0
  549.     Else
  550.       Setcolor 0,7,7,7
  551.       Setcolor 1,0,0,0
  552.     Endif
  553.   Endif
  554. Return
  555. '
  556. '
  557. ' =============================================================================
  558. '              GENERALIZED ROUTINES TO PROCESS THE OPTION LIST
  559. ' =============================================================================
  560. '
  561. ' -----------------------------------------------------------------------------
  562. ' SHOW_OPTION_LIST:  Using DATA statements, build the list of options.
  563. '        Before calling this procedure, use a RESTORE command to point to
  564. '        the DATA statements for the option list.
  565. ' -----------------------------------------------------------------------------
  566. Procedure Show_option_list
  567.   Cls
  568.   Color 2
  569.   Defline 1,1,0,0
  570.   '
  571.   Read Offset%,Spacing%
  572.   Offset%=Offset%*Rez%
  573.   Spacing%=Spacing%*Rez%
  574.   '
  575.   Read Num_select%
  576.   For I%=1 To Num_select%
  577.     Read Select$
  578.     Y%=Spacing%*(I%-1)+Offset%
  579.     Deftext 2,0,0,Txt_size%
  580.     Text 192,Y%-Rez%,"F"
  581.     Text 200,Y%-Rez%,I%
  582.     Rbox 180,Y%-9*Rez%,221,Y%+Rez%
  583.     Deftext 1,0,0,Txt_size%
  584.     Text 248,Y%-Rez%,Select$
  585.   Next I%
  586.   '
  587.   Gosub Build_box
  588.   Text 160,152*Rez%,"Press function key of desired option,"
  589.   Text 304,160*Rez%,"or"
  590.   Text 160,168*Rez%,"click the MOUSE on the desired option."
  591. Return
  592. '
  593. ' -----------------------------------------------------------------------------
  594. ' DATA for OPTION LIST:  Options are listed using the TEXT command.
  595. '        First data value gives the Y coordinate for the first option.
  596. '        Second value gives the text spacing between options.
  597. '        Third value is the number of options followed by their text values.
  598. ' -----------------------------------------------------------------------------
  599. Main_option_list_data:
  600. Data 48,22
  601. Data 3
  602. Data Create New Records
  603. Data List/Edit/Delete Records
  604. Data Quit
  605. '
  606. '
  607. ' =============================================================================
  608. ' CHECK_WHICH_OPTION:  Processes user inputs from the Option Screen.
  609. ' -----------------------------------------------------------------------------
  610. Procedure Check_which_option
  611.   On Menu Key Gosub Check_function_key
  612.   On Menu Button 1,1,1 Gosub Compute_mouse_option
  613.   '
  614.   Function%=0
  615.   Redraw%=0
  616.   Repeat
  617.     On Menu
  618.   Until (Function%>0 And Function%<=Num_select%) Or Redraw%=1
  619. Return
  620. '
  621. '
  622. ' =============================================================================
  623. ' CHECK_FUNCTION_KEY:  Only responds if function key matches an option.
  624. ' -----------------------------------------------------------------------------
  625. Procedure Check_function_key
  626.   If (Menu(14) And 255)=0 Then
  627.     Key%=Menu(14)/256
  628.     If Key%>58 And Key%<=58+Num_select% Then
  629.       Function%=Key%-58
  630.     Endif
  631.   Endif
  632. Return
  633. '
  634. '
  635. ' =============================================================================
  636. ' COMPUTE_MOUSE_OPTION:  Only responds if MOUSE was clicked on an option.
  637. ' -----------------------------------------------------------------------------
  638. Procedure Compute_mouse_option
  639.   Y%=Menu(11)-22*Rez%
  640.   Y1%=Y%-Offset%+9*Rez%
  641.   Y2%=Int(Y1%/Spacing%)
  642.   Y3%=Y1%-Y2%*Spacing%
  643.   If Y3%>=0 And Y3%<=10*Rez% Then
  644.     Function%=Y2%+1
  645.   Endif
  646. Return
  647. '
  648. '
  649. ' =============================================================================
  650. '     GENERALIZED ROUTINES FOR DEFINING THE INPUT FIELDS AND SCREEN LAYOUT
  651. ' =============================================================================
  652. '
  653. ' -----------------------------------------------------------------------------
  654. ' FLD_DIMEN:  Dimension the Field Arrays (large enough for the largest set).
  655. ' -----------------------------------------------------------------------------
  656. Procedure Fld_dimen
  657.   Max_flds%=6
  658.   Dim Fld_hstart%(Max_flds%),Fld_yline%(Max_flds%),Fld_xstart%(Max_flds%)
  659.   Dim Fld_leng%(Max_flds%),Fld_type$(Max_flds%),Fld_heading$(Max_flds%)
  660.   Dim Fld_prompt$(Max_flds%),Fld_help$(Max_flds%)
  661.   Dim Fld_val$(Max_flds%)
  662. Return
  663. '
  664. '
  665. ' =============================================================================
  666. ' FLD_SETUP:  For each different screen, read the DATA statements that define
  667. '        each field on the screen, and build the screen definition arrays.
  668. ' -----------------------------------------------------------------------------
  669. Procedure Fld_setup
  670.   Read Num_flds%
  671.   For I%=1 To Num_flds%
  672.     Read Fld_hstart%(I%),Fld_yline%(I%),Fld_xstart%(I%)
  673.     Read Fld_leng%(I%),Fld_type$(I%),Fld_heading$(I%)
  674.     Read Fld_prompt$(I%),Fld_help$(I%)
  675.   Next I%
  676. Return
  677. '
  678. ' -----------------------------------------------------------------------------
  679. ' DATA for SCREEN SETUP:  First data value tells how many sets of data follow.
  680. '        Each set contains four numeric values and four text values:
  681. '           Y coordinate, X coordinate of header, X coordinate of field,
  682. '           length, type, heading, prompt, and help message.
  683. ' -----------------------------------------------------------------------------
  684. Opt1_fld_data:
  685. Data 6
  686. '
  687. Data 120,40,168,25,A-Z,Name
  688. Data "Enter friend's name."
  689. Data "Friend's name is required.  It must be alphabetic."
  690. '
  691. Data 184,56,248,25,ANY,Street
  692. Data "Enter friend's street address."
  693. Data "Friend's street address is required.  All characters are valid."
  694. '
  695. Data 184,66,248,20,A-Z,City
  696. Data "Enter city where friend lives."
  697. Data "Friend's city is optional.  Must be alphabetic."
  698. '
  699. Data 184,76,248,12,A-Z,State
  700. Data "Enter state where friend lives."
  701. Data "Friend's state is optional.  Must be alphabetic."
  702. '
  703. Data 184,86,248,5,NUM,Zip
  704. Data "Enter zip code for friend's address."
  705. Data "Friend's zip is optional.  Must be numeric."
  706. '
  707. Data 264,108,328,14,PHN,Phone
  708. Data "Enter friend's phone number."
  709. Data "Only numbers, blanks, dashes and parentheses allowed."
  710. '
  711. '
  712. ' =============================================================================
  713. ' SHOW_HEADINGS:  Using the screen definition arrays, build the screen and
  714. '        build the instruction box at the bottom of the screen.
  715. ' -----------------------------------------------------------------------------
  716. Procedure Show_headings
  717.   Cls
  718.   Defline 1,1,0,0
  719.   Color 2
  720.   Print At(2,2);"Record #: ";Rec_num%
  721.   For I%=1 To Num_flds%
  722.     Y%=Fld_yline%(I%)*Rez%
  723.     Text Fld_hstart%(I%),Y%,Fld_heading$(I%)
  724.     Text Fld_hstart%(I%)+8*Len(Fld_heading$(I%)),Y%,":"
  725.     X%=Fld_xstart%(I%)
  726.     Text X%,Y%,Fld_val$(I%)
  727.     Line X%,Y%+2,X%-1+8*Fld_leng%(I%),Y%+2
  728.   Next I%
  729.   '
  730.   Gosub Build_box
  731.   Box 4,125*Rez%,634,139*Rez%
  732.   Box 9,127*Rez%,629,137*Rez%
  733.   Deffill 2,1
  734.   Fill 7,126*Rez%
  735.   '
  736.   Deftext 3,0,0,Txt_size%
  737.   Text 24,135*Rez%,"Press F10 when all fields are correct."
  738.   '
  739.   If Insert_mode%=0 Then
  740.     Deftext 2,0,0,Txt_size%
  741.     Text 488,135*Rez%,"Insert mode: Off"
  742.   Else
  743.     Deftext 3,0,0,Txt_size%
  744.     Text 488,135*Rez%,"Insert mode: ON "
  745.   Endif
  746.   Deftext 1,0,0,Txt_size%
  747.   '
  748.   Fld_num%=1
  749.   Xsub%=1
  750. Return
  751. '
  752. '
  753. ' =============================================================================
  754. ' BUILD_BOX:  Draws a box with thick border.
  755. ' -----------------------------------------------------------------------------
  756. Procedure Build_box
  757.   Color 2
  758.   Defline 1,1,0,0
  759.   Box 4,137*Rez%,634,176*Rez%
  760.   Box 9,139*Rez%,629,174*Rez%
  761.   Deffill 2,1
  762.   Fill 7,138*Rez%
  763. Return
  764. '
  765. '
  766. ' =============================================================================
  767. ' CLEAR_BOX:  Erases the inside of the box.
  768. ' -----------------------------------------------------------------------------
  769. Procedure Clear_box
  770.   Deffill 0,1
  771.   Pbox 48,144*Rez%,604,168*Rez%
  772. Return
  773. '
  774. '
  775. ' =============================================================================
  776. '               ROUTINES TO MOVE THE HIGHLIGHT BAR IN OPTION TWO
  777. ' =============================================================================
  778. '
  779. ' -----------------------------------------------------------------------------
  780. ' CHECK_WHICH_RECORD:  Processes user inputs from the list screen in Option 2.
  781. ' -----------------------------------------------------------------------------
  782. Procedure Check_which_record
  783.   On Menu Key Gosub Check_arrow_key
  784.   On Menu Button 1,1,1 Gosub Compute_mouse_record
  785.   '
  786.   Rec_done%=0
  787.   Redraw%=0
  788.   Repeat
  789.     On Menu
  790.   Until Rec_done%>0 Or Redraw%=1
  791. Return
  792. '
  793. '
  794. ' =============================================================================
  795. ' CHECK_ARROW_KEY:  Only responds if the Up Arrow or Down Arrow is pressed.
  796. ' -----------------------------------------------------------------------------
  797. Procedure Check_arrow_key
  798.   If (Menu(14) And 255)=0 Then
  799.     Fkey=Menu(14)/256
  800.     If Fkey=72 Then                      ! Up Arrow
  801.       Nxt_rec%=Show_num%-1
  802.       Gosub Next_record
  803.     Else
  804.       If Fkey=80 Then                    ! Down Arrow
  805.         Nxt_rec%=Show_num%+1
  806.         Gosub Next_record
  807.       Endif
  808.     Endif
  809.   Endif
  810. Return
  811. '
  812. '
  813. ' =============================================================================
  814. ' NEXT_RECORD:  Determines if cursor must jump to top or bottom of list.
  815. ' -----------------------------------------------------------------------------
  816. Procedure Next_record
  817.   Gosub Highlight
  818.   If Nxt_rec%<1 Then
  819.     Show_num%=Show_limit%
  820.   Else
  821.     If Nxt_rec%>Show_limit% Then
  822.       Show_num%=1
  823.     Else
  824.       Show_num%=Nxt_rec%
  825.     Endif
  826.   Endif
  827.   Gosub Highlight
  828. Return
  829. '
  830. '
  831. ' =============================================================================
  832. ' COMPUTE_MOUSE_RECORD:  Computes which record the MOUSE was clicked on.
  833. ' -----------------------------------------------------------------------------
  834. Procedure Compute_mouse_record
  835.   X%=Menu(10)
  836.   Y%=Menu(11)-22*Rez%
  837.   Nxt_rec%=(Y%-32*Rez%)/(8*Rez%)
  838.   Gosub Highlight
  839.   '
  840.   If Y%>154 Then
  841.     If X%<160 And (Show_prev%+Show_limit%)<Num_recs% Then
  842.       Add Show_prev%,12
  843.       Gosub List_15_recs
  844.       Nxt_rec%=1
  845.     Else
  846.       If X%>464 And Show_prev%>0 Then
  847.         Show_prev%=0
  848.         Gosub List_15_recs
  849.         Nxt_rec%=1
  850.       Endif
  851.     Endif
  852.   Endif
  853.   '
  854.   If Nxt_rec%<1 Then
  855.     Show_num%=1
  856.   Else
  857.     If Nxt_rec%>Show_limit% Then
  858.       Show_num%=Show_limit%
  859.     Else
  860.       Show_num%=Nxt_rec%
  861.     Endif
  862.   Endif
  863.   Gosub Highlight
  864. Return
  865. '
  866. '
  867. ' =============================================================================
  868. '                        ROUTINES TO READ AN ENTIRE FIELD
  869. ' =============================================================================
  870. '
  871. ' -----------------------------------------------------------------------------
  872. ' CHECK_FIELD_INPUT:  Processes user inputs from a data entry screen.
  873. ' -----------------------------------------------------------------------------
  874. Procedure Check_field_input
  875.   Hold$=Temp$
  876.   '
  877.   X%=Int((80-Len(Fld_prompt$(Fld_num%)))/2)
  878.   Print At(X%,20);Fld_prompt$(Fld_num%)
  879.   '
  880.   Xstart%=Fld_xstart%(Fld_num%)
  881.   Yline%=Fld_yline%(Fld_num%)*Rez%
  882.   Fleng%=Fld_leng%(Fld_num%)
  883.   Type_input$=Fld_type$(Fld_num%)
  884.   '
  885.   Gosub Cursor
  886.   '
  887.   On Menu Key Gosub Check_field_key
  888.   On Menu Button 1,1,1 Gosub Compute_mouse_field
  889.   '
  890.   Fld_done%=0
  891.   Redraw%=0
  892.   Repeat
  893.     On Menu
  894.   Until Fld_done%>0 Or Redraw%=1
  895. Return
  896. '
  897. '
  898. ' =============================================================================
  899. ' CHECK_FIELD_KEY:  Processes keyboard inputs from a data entry screen.
  900. ' -----------------------------------------------------------------------------
  901. Procedure Check_field_key
  902.   Menu Off
  903.   If Menu(13)>=4 Then                    ! Skip Control & Alternate characters
  904.     Gosub Beep
  905.   Else
  906.     If (Menu(14) And 255)=0 Then
  907.       Gosub Check_special_key
  908.     Else
  909.       Gosub Check_regular_key
  910.     Endif
  911.   Endif
  912. Return
  913. '
  914. '
  915. ' =============================================================================
  916. ' CHECK_REGULAR_KEY:  Processes standard keys.
  917. ' -----------------------------------------------------------------------------
  918. Procedure Check_regular_key
  919.   If Menu(14)=7181 Then                  ! Return
  920.     Gosub Finish_field
  921.   Else
  922.     If Menu(14)=3849                     ! Tab
  923.       Gosub Finish_field
  924.     Else
  925.       If Menu(14)=29197 Then             ! Enter
  926.         Gosub Finish_field
  927.       Else
  928.         If Menu(14)=3592 Then            ! Backspace
  929.           Gosub Have_backspace
  930.         Else
  931.           If Menu(14)=21375 Then         ! Delete
  932.             Gosub Have_delete
  933.           Else
  934.             If Menu(14)=283 Then         ! Escape
  935.               Gosub Clear_field
  936.             Else
  937.               Gosub Have_data            ! add character to field
  938.             Endif
  939.           Endif
  940.         Endif
  941.       Endif
  942.     Endif
  943.   Endif
  944. Return
  945. '
  946. '
  947. ' =============================================================================
  948. ' CHECK_SPECIAL_KEY:  Processes function keys and other special keys.
  949. '     (Only function key F10 is used by the sample data entry screen.)
  950. '             ( Fkey=59 for F1   ---->   Fkey=67 for F9 )
  951. ' -----------------------------------------------------------------------------
  952. Procedure Check_special_key
  953.   Fkey=Menu(14)/256
  954.   If Fkey=72 Then                        ! Up Arrow
  955.     Nxt_fld%=Fld_num%-1
  956.     Nxt_xsub%=1
  957.     Gosub Next_field
  958.   Else
  959.     If Fkey=80 Then                      ! Down Arrow
  960.       Nxt_fld%=Fld_num%+1
  961.       Nxt_xsub%=1
  962.       Gosub Next_field
  963.     Else
  964.       If Fkey=75 Then                    ! Left Arrow
  965.         Gosub Have_left_arrow
  966.       Else
  967.         If Fkey=77 Then                  ! Right Arrow
  968.           Gosub Have_right_arrow
  969.         Else
  970.           If Fkey=82 Then                ! Insert
  971.             Gosub Have_insert
  972.           Else
  973.             If Fkey=71 Then              ! Clr Home
  974.               Gosub Clear_field
  975.             Else
  976.               If Fkey=97 Then            ! Undo
  977.                 Gosub Have_undo_key
  978.               Else
  979.                 If Fkey=98 Then          ! Help
  980.                   Gosub Have_help_key
  981.                 Else
  982.                   If Fkey=68 Then        ! F10
  983.                     Gosub Record_is_done
  984.                   Endif
  985.                 Endif
  986.               Endif
  987.             Endif
  988.           Endif
  989.         Endif
  990.       Endif
  991.     Endif
  992.   Endif
  993. Return
  994. '
  995. '
  996. ' =============================================================================
  997. ' COMPUTE_MOUSE_FIELD:  Computes which field the MOUSE was clicked on.
  998. ' -----------------------------------------------------------------------------
  999. Procedure Compute_mouse_field
  1000.   X%=Menu(10)
  1001.   Y%=Menu(11)-22*Rez%
  1002.   '
  1003.   Fld%=0
  1004.   For I%=1 To Num_flds%
  1005.     If X%>=Fld_hstart%(I%) And X%<Fld_xstart%(I%)+8*Fld_leng%(I%) Then
  1006.       If Y%>=Fld_yline%(I%)-7*Rez% And Y%<Fld_yline%(I%)*Rez% Then
  1007.         Fld%=I%
  1008.       Endif
  1009.     Endif
  1010.     Exit If Fld%>0
  1011.   Next I%
  1012.   '
  1013.   If X%<=Fld_xstart%(Fld%) Then
  1014.     Nxt_xsub%=1
  1015.   Else
  1016.     Nxt_xsub%=Int((X%-Fld_xstart%(Fld%))/8)+1
  1017.   Endif
  1018.   '
  1019.   If Fld%>0 Then
  1020.     If Fld%=Fld_num% Then
  1021.       Gosub Cursor
  1022.       Xsub%=Nxt_xsub%
  1023.       Gosub Cursor
  1024.     Else
  1025.       Nxt_fld%=Fld%
  1026.       Gosub Next_field
  1027.     Endif
  1028.   Endif
  1029. Return
  1030. '
  1031. '
  1032. ' =============================================================================
  1033. ' CURSOR:  Draws or erases the cursor block.
  1034. ' -----------------------------------------------------------------------------
  1035. Procedure Cursor
  1036.   Graphmode 3
  1037.   Deffill 1,1
  1038.   Xchar%=Xstart%+(Xsub%-1)*8
  1039.   Pbox Xchar%-1,Yline%+2*Rez%,Xchar%+8,Yline%-8*Rez%
  1040.   Graphmode 1
  1041. Return
  1042. '
  1043. '
  1044. ' =============================================================================
  1045. ' HAVE_DATA:  Check if key is valid for this field type.
  1046. ' -----------------------------------------------------------------------------
  1047. Procedure Have_data
  1048.   C$=Chr$(Menu(14))
  1049.   If Type_input$="ANY" Then
  1050.     Gosub Keep_data
  1051.   Else
  1052.     If Type_input$="A-Z" Then
  1053.       If Instr(" .,-ABCDEFGHIJKLMNOPQRSTUVWXYZ",Upper$(C$)) Then
  1054.         Gosub Keep_data
  1055.       Else
  1056.         Gosub Beep
  1057.       Endif
  1058.     Else
  1059.       If Type_input$="NUM" Then
  1060.         If Instr("0123456789",C$) Then
  1061.           Gosub Keep_data
  1062.         Else
  1063.           Gosub Beep
  1064.         Endif
  1065.       Else
  1066.         If Instr(" ()-0123456789",C$) Then
  1067.           Gosub Keep_data
  1068.         Else
  1069.           Gosub Beep
  1070.         Endif
  1071.       Endif
  1072.     Endif
  1073.   Endif
  1074. Return
  1075. '
  1076. '
  1077. ' =============================================================================
  1078. ' KEEP_DATA:  Key is valid, so add it to the field.
  1079. ' -----------------------------------------------------------------------------
  1080. Procedure Keep_data
  1081.   Gosub Cursor
  1082.   '
  1083.   If Insert_mode%=1 Then
  1084.     L%=Fleng%-Xsub%
  1085.     If L%>0 Then
  1086.       Mid$(Temp$,Xsub%+1,L%)=Mid$(Temp$,Xsub%,L%)
  1087.       Mid$(Temp$,Xsub%,1)=" "
  1088.       Text Xstart%,Yline%,Temp$
  1089.     Endif
  1090.   Endif
  1091.   '
  1092.   Text Xchar%,Yline%,C$
  1093.   Mid$(Temp$,Xsub%,1)=C$
  1094.   If Xsub%<Fleng% Then
  1095.     Inc Xsub%
  1096.     Add Xchar%,8
  1097.   Endif
  1098.   Gosub Cursor
  1099. Return
  1100. '
  1101. '
  1102. ' =============================================================================
  1103. ' BEEP:  Key is not valid, so make a beeping noise.
  1104. ' -----------------------------------------------------------------------------
  1105. Procedure Beep
  1106.   Sound 1,12,1,8,1
  1107.   Sound 1,0,0,0
  1108. Return
  1109. '
  1110. '
  1111. ' =============================================================================
  1112. ' FINISH_FIELD:  Set flag for field done, determine which field is next.
  1113. ' -----------------------------------------------------------------------------
  1114. Procedure Finish_field
  1115.   Gosub Cursor
  1116.   '
  1117.   Fld_done%=1
  1118.   Nxt_fld%=Fld_num%+1
  1119.   If Nxt_fld%>Num_flds% Then
  1120.     Nxt_fld%=1
  1121.   Endif
  1122.   Xsub%=1
  1123. Return
  1124. '
  1125. '
  1126. ' =============================================================================
  1127. ' NEXT_FIELD:  Field may not be done, determine which field is next.
  1128. ' -----------------------------------------------------------------------------
  1129. Procedure Next_field
  1130.   Gosub Cursor
  1131.   '
  1132.   Fld_done%=99
  1133.   If Nxt_fld%<1 Then
  1134.     Nxt_fld%=Num_flds%
  1135.   Else
  1136.     If Nxt_fld%>Num_flds% Then
  1137.       Nxt_fld%=1
  1138.     Endif
  1139.   Endif
  1140.   Xsub%=Nxt_xsub%
  1141. Return
  1142. '
  1143. '
  1144. ' =============================================================================
  1145. ' HAVE_LEFT_ARROW:  Move cursor left but leave data as is.
  1146. ' -----------------------------------------------------------------------------
  1147. Procedure Have_left_arrow
  1148.   If Xsub%>1 Then
  1149.     Gosub Cursor
  1150.     Dec Xsub%
  1151.     Gosub Cursor
  1152.   Endif
  1153. Return
  1154. '
  1155. '
  1156. ' =============================================================================
  1157. ' HAVE_RIGHT_ARROW:  Move cursor right but leave data as is.
  1158. ' -----------------------------------------------------------------------------
  1159. Procedure Have_right_arrow
  1160.   If Xsub%<Fleng% Then
  1161.     Gosub Cursor
  1162.     Inc Xsub%
  1163.     Gosub Cursor
  1164.   Endif
  1165. Return
  1166. '
  1167. '
  1168. ' =============================================================================
  1169. ' HAVE_BACKSPACE:  Move cursor left, pulling data with it.
  1170. ' -----------------------------------------------------------------------------
  1171. Procedure Have_backspace
  1172.   If Xsub%>1 Then
  1173.     Gosub Cursor
  1174.     Dec Xsub%
  1175.     Gosub Cursor
  1176.     Gosub Have_delete
  1177.   Endif
  1178. Return
  1179. '
  1180. '
  1181. ' =============================================================================
  1182. ' HAVE_DELETE:  Pull data from the right into this position.
  1183. ' -----------------------------------------------------------------------------
  1184. Procedure Have_delete
  1185.   Gosub Cursor
  1186.   L%=Fleng%-Xsub%
  1187.   If L%=0 Then
  1188.     Mid$(Temp$,Fleng%,1)=" "
  1189.     Text Xchar%,Yline%," "
  1190.   Else
  1191.     Mid$(Temp$,Xsub%,L%)=Mid$(Temp$,Xsub%+1,L%)
  1192.     Mid$(Temp$,Fleng%,1)=" "
  1193.     Text Xstart%,Yline%,Temp$
  1194.   Endif
  1195.   Gosub Cursor
  1196. Return
  1197. '
  1198. '
  1199. ' =============================================================================
  1200. ' HAVE_INSERT:  Toggle INSERT mode off and on.
  1201. ' -----------------------------------------------------------------------------
  1202. Procedure Have_insert
  1203.   If Insert_mode%=0 Then
  1204.     Insert_mode%=1
  1205.     Deftext 3,0,0,Txt_size%
  1206.     Text 488,135*Rez%,"Insert mode: ON "
  1207.   Else
  1208.     Insert_mode%=0
  1209.     Deftext 2,0,0,Txt_size%
  1210.     Text 488,135*Rez%,"Insert mode: Off"
  1211.   Endif
  1212.   Deftext 1,0,0,Txt_size%
  1213. Return
  1214. '
  1215. '
  1216. ' =============================================================================
  1217. ' CLEAR_FIELD:  Set the current field to spaces.
  1218. ' -----------------------------------------------------------------------------
  1219. Procedure Clear_field
  1220.   Gosub Cursor
  1221.   Temp$=Space$(Fleng%)
  1222.   Xsub%=1
  1223.   Text Xstart%,Yline%,Temp$
  1224.   Gosub Cursor
  1225. Return
  1226. '
  1227. '
  1228. ' =============================================================================
  1229. ' HAVE_UNDO_KEY:  Restore the original value of the current field.
  1230. ' -----------------------------------------------------------------------------
  1231. Procedure Have_undo_key
  1232.   Gosub Cursor
  1233.   Temp$=Hold$
  1234.   Xsub%=1
  1235.   Text Xstart%,Yline%,Temp$
  1236.   Gosub Cursor
  1237. Return
  1238. '
  1239. '
  1240. ' =============================================================================
  1241. ' HAVE_HELP_KEY:  Display the HELP message.
  1242. ' -----------------------------------------------------------------------------
  1243. Procedure Have_help_key
  1244.   X%=Int((80-Len(Fld_help$(Fld_num%)))/2)
  1245.   Print At(X%,21);Fld_help$(Fld_num%)
  1246. Return
  1247. '
  1248. '
  1249. ' =============================================================================
  1250. ' RECORD_IS_DONE:  Set flags to end the input process.
  1251. ' -----------------------------------------------------------------------------
  1252. Procedure Record_is_done
  1253.   Gosub Cursor
  1254.   Fld_done%=1
  1255.   Rec_done%=1
  1256. Return
  1257. '
  1258. ' ------------- SAVE ORIGINAL COLOR PALETTE -----------------------
  1259. Procedure Save_pal
  1260.   '
  1261.   ' Requires Dim Spalette%(16,3)
  1262.   '
  1263.   For Z%=0 To 15
  1264.     Dpoke Contrl,26
  1265.     Dpoke Contrl+2,0
  1266.     Dpoke Contrl+6,2
  1267.     Dpoke Intin,Z%
  1268.     Dpoke Intin+2,0
  1269.     Vdisys
  1270.     Spalette%(Z%,0)=Dpeek(Intout+2)
  1271.     Spalette%(Z%,1)=Dpeek(Intout+4)
  1272.     Spalette%(Z%,2)=Dpeek(Intout+6)
  1273.   Next Z%
  1274. Return
  1275. '
  1276. Procedure Restorepal
  1277.   ' --------------------- RESTORES PALLET -------------------
  1278.   ' Dimensions: Spalette%(16,3)
  1279.   '
  1280.   For Z%=0 To 15
  1281.     Dpoke Contrl,14
  1282.     Dpoke Contrl+2,0
  1283.     Dpoke Contrl+6,4
  1284.     Dpoke Intin,Z%
  1285.     Dpoke Intin+2,Spalette%(Z%,0)
  1286.     Dpoke Intin+4,Spalette%(Z%,1)
  1287.     Dpoke Intin+6,Spalette%(Z%,2)
  1288.     Vdisys
  1289.   Next Z%
  1290. Return
  1291. ' ---------------------------  END OF LISTING 2  ------------------------------
  1292.